home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 31 / ted21a.zip / TED.LSP < prev    next >
Lisp/Scheme  |  1988-05-29  |  12KB  |  408 lines
  1. ; TED 2.1a
  2. ; Full screen line editor for AutoCAD text entities.
  3. ; Please read TED.DOC for installation and operation instructions.
  4. ; This is a shareware product. If you use TED, you must register.
  5. ; Copyright 1988 Alacrity
  6.  
  7. (defun c:TED (/ ss process escape modify key ent num entlst deltxt len nkey
  8.                 i chglin txtlst tab display txtlin cursor ins mode comlin err
  9.                 entdata txt modtxt clear x insert p lst delete chglst okey)
  10.   ;---------------
  11.   ; Error Handler
  12.   ;---------------
  13.   (setq err *error*)
  14.   (defun *error* (msg)
  15.     (okey)
  16.     (clear)
  17.     (setq *error* err)
  18.     (princ msg)
  19.     (princ)
  20.   )
  21.   ;--------------------------
  22.   ; Process alphanumeric key
  23.   ;--------------------------
  24.   (defun process ()
  25.     ; Insert or Replace
  26.     (if ins
  27.       (progn
  28.         ; Print change, make change to txt
  29.         (setq txt (strcat (substr txt 1 (1- p))
  30.                           (princ (chr key))
  31.                           (princ (substr txt p))))
  32.         (princ "\004")
  33.         ; Add to pointer, length
  34.         (setq p (1+ p) len (1+ len))
  35.         ; Position cursor
  36.         (cursor)
  37.       )
  38.       (progn
  39.         ; Print change, make change to txt
  40.         (setq txt (strcat (substr txt 1 (1- p))
  41.                           (princ (chr key))
  42.                           (substr txt (1+ p))))
  43.         ; Add to length if end of line
  44.         (if (> p len)
  45.           (progn
  46.             (setq len (1+ len))
  47.             (princ "\004")
  48.           )
  49.         )
  50.         ; Add to pointer
  51.         (setq p (1+ p))
  52.         ; Position cursor
  53.         (cursor)
  54.       )
  55.     )
  56.   )
  57.   ;-----------------
  58.   ; Position Cursor 
  59.   ;-----------------
  60.   (defun cursor ()
  61.     ; Write current cursor position
  62.     (princ (strcat "\e[2;26H" (itoa p) " "
  63.       ; Position cursor
  64.       "\e[" (itoa (+ 5 txtlin)) ";" (itoa p) "H"))
  65.   )
  66.   ;---------------------
  67.   ; Delete atom in list
  68.   ;---------------------
  69.   (defun delete (lst p)
  70.     (cond
  71.       ((zerop p) (cdr lst))
  72.       (T (cons (car lst) (delete (cdr lst) (1- p))))
  73.     )
  74.   )
  75.   ;---------------------
  76.   ; Insert atom in list
  77.   ;---------------------
  78.   (defun insert (lst x p)
  79.     (cond
  80.       ((zerop p) (cons x lst))
  81.       (T (cons (car lst) (insert (cdr lst) x (1- p))))
  82.     )
  83.   )
  84.   ;---------------------
  85.   ; Change current line
  86.   ;---------------------
  87.   (defun chglin (i)
  88.     ; Has text changed? 
  89.     (if txt (chglst))
  90.     ; Set variables 
  91.     (setq txtlin (+ i txtlin)       ; current text line
  92.           p 1                       ; string position 
  93.           txt (nth txtlin txtlst)   ; current text string
  94.           len (strlen txt)          ; length of text string
  95.     )
  96.     ; Write current line number to status line
  97.     (princ (strcat "\e[2;15H" (itoa (1+ txtlin)) " "))
  98.     (cursor)
  99.   )
  100.   ;--------------------
  101.   ; Modify text entity
  102.   ;--------------------
  103.   (defun modtxt ()
  104.     (setq entdata (entget (nth txtlin entlst)))
  105.     (entmod (subst (cons 1 txt) (assoc 1 entdata) entdata))
  106.   )
  107.   ;--------------------
  108.   ; Clear command line
  109.   ;--------------------
  110.   (defun comlin () (princ "\e[3;1H\e[K"))
  111.   ;-------------------
  112.   ; Update text list
  113.   ;-------------------
  114.   (defun chglst ()
  115.      ; Has text changed
  116.      (if (/= txt (nth txtlin txtlst)) 
  117.         ; Yes, update txtlst
  118.         (setq txtlst (insert (delete txtlst txtlin) txt txtlin))
  119.      )
  120.   )
  121.   ;----------------------
  122.   ; Toggle Insert ON/OFF
  123.   ;----------------------
  124.   (defun mode ()
  125.     ; Toggle
  126.     (setq ins (not ins))
  127.     ; Save cursor position, locate cursor on status line
  128.     ; Print insert mode
  129.     ; restore cursor position
  130.     (princ (strcat "\e[s\e[2;1H" (if ins "Insert " "Replace") "\e[u"))
  131.   )
  132.   ;-------------------------
  133.   ; Clear screen of garbage
  134.   ;-------------------------
  135.   (defun clear ()
  136.     (okey)
  137.     (princ "\e[2J")
  138.     (repeat 24 (terpri))
  139.     (graphscr)
  140.     (princ "\n \n \n \n")
  141.   )
  142.   ;---------------------
  143.   ; Generate TED display
  144.   ;---------------------
  145.   (defun display ()
  146.     ; Clear screen
  147.     (textscr)
  148.     ; Redefine keys
  149.     (nkey)
  150.     ; Title line
  151.     (princ 
  152.       (strcat
  153.         "\e[2J\e[0mTED 2.1a (c) 1988 Alacrity    \e[7mF2\e[0mModify\e[7mNA\e[0mJoin"
  154.         "\e[7mNA\e[0mBreak\e[7mNA\e[0mCopy\e[7mNA\e[0mPaste\e[7mNA\e[0mUpper\e[7mNA" 
  155.         "\e[0mLower\n" 
  156.         (if ins "Insert " "Replace") 
  157.         "  Line " 
  158.         (itoa (1+ txtlin)) 
  159.         "\e[2;19HColumn " 
  160.         (itoa p)
  161.         "\e[2;31H\020 \021 \036 \037 Home End Ins Del BackSpace TAB ShftTAB ESC\n"
  162.       )
  163.     )
  164.     ; Tab stops line
  165.     (repeat 16 (princ tab))
  166.     ; Write text strings
  167.     (mapcar
  168.       '(lambda (x)
  169.         (princ (strcat x "\004\n"))
  170.       )
  171.       txtlst
  172.     )
  173.   )
  174.   ;--------------------
  175.   ; Delete Text Entity
  176.   ;--------------------
  177.   (defun deltxt ()
  178.     ; Clear screen
  179.     (clear)
  180.     ; Delete entity
  181.     (entdel (nth txtlin entlst))
  182.     ; Update variables
  183.     (setq txtlst (delete txtlst txtlin) 
  184.           entlst (delete entlst txtlin)
  185.           txt nil
  186.           num (1- num)
  187.     )
  188.     ; Still have text? 
  189.     (if (zerop num)
  190.       ; No, quit
  191.       nil
  192.       ; Yes, 
  193.       (progn
  194.         ; Regen display
  195.         (display)
  196.         ; Reposition cursor
  197.         (if (zerop txtlin)
  198.           (chglin 0)
  199.           (chglin -1)
  200.         )
  201.       )
  202.     )
  203.   )
  204.   ;---------------------------
  205.   ; Modify text, Regen screen
  206.   ;---------------------------
  207.   (defun modify ()
  208.     (clear)
  209.     (modtxt)
  210.     ; Update txtlst
  211.     (chglst)
  212.     ; Continue or Quit
  213.     (princ "Any key to continue, [ESC] to end.")
  214.     (if (= (cadr (grread)) 27)
  215.       ; ESCAPE (Quit)
  216.       (escape)
  217.       ; Continue
  218.       (progn
  219.         (display)
  220.         (cursor)
  221.       )
  222.     )
  223.   )
  224.   ;------------------
  225.   ; Ecape (Quit TED)
  226.   ;------------------
  227.   (defun escape ()
  228.     ; Has text changed?
  229.     (chglst) 
  230.     ; Clear command line
  231.     (comlin)
  232.     ; Update text?
  233.     (initget "Yes No")
  234.     (setq key (getkword "Make changes? No/<Yes>: "))
  235.     ; Clear screen
  236.     (clear)
  237.     (if (/= key "No")
  238.       (mapcar
  239.         '(lambda (ent txt)
  240.           ; Get entity list
  241.           (setq entdata (entget ent))
  242.           ; Has text been changed?
  243.           (if (/= (cdr (assoc 1 entdata)) txt)
  244.             ; Yes, make changes
  245.             (entmod (subst (cons 1 txt) (assoc 1 entdata) entdata))
  246.           )
  247.         )
  248.         entlst txtlst
  249.       )
  250.     )
  251.     ; Quit TED
  252.     nil
  253.   )
  254.   ;---------------------
  255.   ; New Key Definitions
  256.   ;---------------------
  257.   (defun nkey ()
  258.     (princ "\e[0;75;0;115p\e[0;77;0;116p\e[0;71;0;119p\e[0;79;0;117p\e[0;73;0;132p") 
  259.     (princ "\e[0;81;0;118p\e[0;82;0;23p\e[0;83;0;32p\e[0;72;0;132p\e[0;80;0;118p") 
  260.   )
  261.   ;---------------------
  262.   ; Old Key Definitions
  263.   ;---------------------
  264.   (defun okey ()
  265.     (princ "\e[0;75;0;75p\e[0;77;0;77p\e[0;71;0;71p\e[0;74;0;74p\e[0;73;0;73p")
  266.     (princ "\e[0;81;0;81p\e[0;82;0;82p\e[0;83;0;83p\e[0;72;0;72p\e[0;80;0;80p") 
  267.   )
  268.   ;----------------------------
  269.   ; Initialize some parameters
  270.   ;----------------------------
  271.   (gc)
  272.   (setvar "CmdEcho" 0)
  273.   (setq num 0
  274.         p 1
  275.         txtlin 0
  276.         tab (strcat "+" (chr 205) (chr 205) (chr 205) (chr 205))
  277.   )
  278.   ;-----------------------------------------------------------
  279.   ; Create entlst of text entities and txtlst of text strings
  280.   ;-----------------------------------------------------------
  281.   (if (setq ss (ssget))
  282.     (progn
  283.       (while (and (setq ent (ssname ss 0)) (< num 15))
  284.         (if (equal (cdr (assoc 0 (entget ent))) "TEXT")
  285.           (setq entlst (append entlst (list ent))
  286.                 txtlst (append txtlst 
  287.                   (list (substr (cdr (assoc 1 (entget ent))) 1 79)))
  288.                 num (1+ num)
  289.           )
  290.         )
  291.         (ssdel ent ss)
  292.       )
  293.       (setq txt (nth 0 txtlst)
  294.             ent (nth 0 entlst)
  295.       )
  296.     )
  297.   )
  298.   ;--------------
  299.   ; Main routine
  300.   ;--------------
  301.   ; Are there any text entities selected?
  302.   (if entlst
  303.     ; Yes, edit them
  304.     (progn
  305.       ; Draw display
  306.       (display)
  307.       ; Initialize cursor position
  308.       (chglin 0)
  309.       (while 
  310.         (and
  311.           ; Are there text lines to edit?
  312.           (if (zerop num) nil T)
  313.           ; Get input from user
  314.           (if (= (car (setq key (grread))) 2)
  315.             (progn
  316.               (setq key (cadr key))
  317.               (cond
  318.                 ; Alphanumeric key 
  319.                 ((not (or (< key 32) (> key 126) (> p 80))) (process))
  320.                 ; Ctrl Left arrow 
  321.                 ((not (or (/= key 243) (< p 2)))
  322.                   (progn (setq p (1- p)) (cursor))
  323.                 )
  324.                 ; Ctrl Right arrow
  325.                 ((not (or (/= key 244) (> p len))) 
  326.                   (progn (setq p (1+ p)) (cursor))
  327.                 )
  328.                 ; Backspace
  329.                 ((not (or (/= key 8) (< p 2))) 
  330.                   (progn
  331.                     (setq p (1- p))
  332.                     (cursor)
  333.                     (setq txt (strcat (substr txt 1 (1- p))
  334.                       (princ (substr txt (1+ p))))
  335.                     )
  336.                     (princ "\004 ")
  337.                     (setq len (1- len))
  338.                     (cursor)
  339.                   )
  340.                 )
  341.                 ; TAB
  342.                 ((= key 9) 
  343.                   (progn
  344.                     (setq p (if (= (/ (1- p) 5) (/ (1- p) 5.0))
  345.                       (+ p 5)
  346.                       (+ 6 (* (/ (1- p) 5) 5))))
  347.                     (if (>= p len) (setq p (1+ len)))
  348.                     (cursor)
  349.                   )
  350.                 )
  351.                 ; Shift TAB
  352.                 ((= key 143) 
  353.                   (progn
  354.                     (setq p (if (= (/ (1- p) 5) (/ (1- p) 5.0))
  355.                       (- p 5)
  356.                       (1+ (* (/ (1- p) 5) 5))))
  357.                     (if (< p 1) (setq p 1))
  358.                     (cursor)
  359.                   )
  360.                 )
  361.                 ; Home
  362.                 ((= key 247) (progn (setq p 1) (cursor)))
  363.                 ; End
  364.                 ((= key 245) (progn (setq p (1+ len)) (cursor)))
  365.                 ; Down arrow or ENTER
  366.                 ((or (= key 246) (= key 13)) 
  367.                   (cond
  368.                     ; Less then number of text lines
  369.                     ((< txtlin (1- num)) (chglin 1))
  370.                     ; Can do no more lines
  371.                     (T (chglin 0))
  372.                   )
  373.                 )
  374.                 ; Up arrow 
  375.                 ((not (or (/= key 132) (<= txtlin 0))) (chglin -1))
  376.                 ; Modify F2
  377.                 ((= key 188) (modify))
  378.                 ; Delete
  379.                 ((not (or (/= key 160) (> p len))) 
  380.                   (progn
  381.                     (setq txt (strcat (substr txt 1 (1- p))
  382.                       (princ (substr txt (1+ p)))))
  383.                     (princ "\004 ")
  384.                     (setq len (1- len))
  385.                     (cursor)
  386.                   )
  387.                 )
  388.                 ; Insert
  389.                 ((= key 151) (mode)) 
  390.                 ; ESCAPE 
  391.                 ((= key 27) (escape))
  392.                 ; Fall through
  393.                 (T T)
  394.               )
  395.             )
  396.             T
  397.           )
  398.           ; Is text string empty?
  399.           (if (< len 1) (deltxt) T)
  400.         )
  401.       )
  402.     )
  403.   )
  404.   (setq *error* err)
  405.   (princ)
  406. )
  407. ; End of File
  408.